home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 November / SGI Freeware 1999 November - Disc 1.iso / dist / fw_Tix.idb / usr / freeware / bin / tixindex.z / tixindex
Text File  |  1999-01-26  |  2KB  |  67 lines
  1. #!/bin/sh
  2. # the next line restarts using tclsh \
  3. exec tclsh "$0" "$@"
  4.  
  5. proc tixAutoMkIndex {dir args} {
  6.     global errorCode errorInfo
  7.     set oldDir [pwd]
  8.     cd $dir
  9.     set dir [pwd]
  10.     append index "# Tcl autoload index file, version 2.0\n"
  11.     append index "# This file is generated by the \"tixindex\" program,\n"
  12.     append index "# *NOT* by the \"auto_mkindex\" command,\n"
  13.     append index "# and sourced to set up indexing information for one or\n"
  14.     append index "# more commands.  Typically each line is a command that\n"
  15.     append index "# sets an element in the auto_index array, where the\n"
  16.     append index "# element name is the name of a command and the value is\n"
  17.     append index "# a script that loads the command.\n\n"
  18.     foreach file [eval glob $args] {
  19.     set f ""
  20.     set error [catch {
  21.         set f [open $file]
  22.         while {[gets $f line] >= 0} {
  23.         if [regexp {^tixClass[     ]+([^     ]*)} $line match className] {
  24.             append index "set [list auto_index($className)]"
  25.             append index " \"source {\$dir/$file}\"\n"
  26.             append index "set [list auto_index($className:AutoLoad)]"
  27.             append index " \"source {\$dir/$file}\"\n"
  28.             set isClass($className) 1
  29.         }
  30.         if [regexp {^tixWidgetClass[     ]+([^     ]*)} $line match className] {
  31.             append index "set [list auto_index($className)]"
  32.             append index " \"source {\$dir/$file}\"\n"
  33.             append index "set [list auto_index($className:AutoLoad)]"
  34.             append index " \"source {\$dir/$file}\"\n"
  35.             set isClass($className) 1
  36.         }
  37.  
  38.         if [regexp {^proc[     ]+([^     ]*)} $line match procName] {
  39.             set prefix [lindex [split $procName :] 0]
  40.             if {![info exists isClass($prefix)]} {
  41.             append index "set [list auto_index($procName)]"
  42.             append index " \"source {\$dir/$file}\"\n"
  43.             }
  44.         }
  45.         }
  46.         close $f
  47.     } msg]
  48.     if $error {
  49.         set code $errorCode
  50.         set info $errorInfo
  51.         catch {close $f}
  52.         cd $oldDir
  53.         error $msg $info $code
  54.     }
  55.     }
  56.     set f [open tclIndex w]
  57.     puts $f $index nonewline
  58.     close $f
  59.     cd $oldDir
  60. }
  61.  
  62. if {$argv == {}} {
  63.     eval tixAutoMkIndex . *.tcl
  64. } else {
  65.     eval tixAutoMkIndex . $argv
  66. }
  67.